home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 5 Developer's Kit / vb5 dev kit.iso / dev / ftp4w26a / samples / basic / ftpproto.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-06-10  |  12.7 KB  |  421 lines
  1. VERSION 2.00
  2. Begin Form FTP_form 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "FTP file transfer utility "
  6.    ClientHeight    =   4020
  7.    ClientLeft      =   1005
  8.    ClientTop       =   2385
  9.    ClientWidth     =   8085
  10.    Height          =   4710
  11.    Icon            =   FTPPROTO.FRX:0000
  12.    Left            =   945
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   4020
  16.    ScaleWidth      =   8085
  17.    Top             =   1755
  18.    Width           =   8205
  19.    Begin ListBox Dir_list 
  20.       Height          =   2955
  21.       Left            =   120
  22.       TabIndex        =   4
  23.       Top             =   360
  24.       Width           =   7815
  25.    End
  26.    Begin Line Line1 
  27.       X1              =   0
  28.       X2              =   8040
  29.       Y1              =   3480
  30.       Y2              =   3480
  31.    End
  32.    Begin Label Message 
  33.       DragMode        =   1  'Automatic
  34.       Height          =   255
  35.       Left            =   1320
  36.       TabIndex        =   1
  37.       Top             =   3600
  38.       Width           =   4815
  39.    End
  40.    Begin Label Label3 
  41.       BackColor       =   &H00C0C0C0&
  42.       Caption         =   "Messages :"
  43.       Height          =   255
  44.       Left            =   240
  45.       TabIndex        =   3
  46.       Top             =   3600
  47.       Width           =   1095
  48.    End
  49.    Begin Label Host_name 
  50.       BackColor       =   &H00C0C0C0&
  51.       Caption         =   "< Not connected >"
  52.       Height          =   255
  53.       Left            =   1680
  54.       TabIndex        =   2
  55.       Top             =   120
  56.       Width           =   1695
  57.    End
  58.    Begin Label Label1 
  59.       BackColor       =   &H00C0C0C0&
  60.       Caption         =   "Host :"
  61.       Height          =   255
  62.       Left            =   240
  63.       TabIndex        =   0
  64.       Top             =   120
  65.       Width           =   1215
  66.    End
  67.    Begin Menu Menu_connection 
  68.       Caption         =   "&Action"
  69.       Begin Menu Menu_connection_item 
  70.          Caption         =   "&Connect.."
  71.          Index           =   0
  72.       End
  73.       Begin Menu Menu_connection_item 
  74.          Caption         =   "&Disconnect.."
  75.          Index           =   1
  76.       End
  77.       Begin Menu Menu_connection_item 
  78.          Caption         =   "&Abort"
  79.          Index           =   2
  80.       End
  81.       Begin Menu Menu_connection_item 
  82.          Caption         =   "&Exit"
  83.          Index           =   3
  84.       End
  85.    End
  86.    Begin Menu Menu_file 
  87.       Caption         =   "&File"
  88.       Begin Menu Menu_file_item 
  89.          Caption         =   "&Get.."
  90.          Index           =   0
  91.       End
  92.       Begin Menu Menu_file_item 
  93.          Caption         =   "&Put.."
  94.          Index           =   1
  95.       End
  96.    End
  97.    Begin Menu Menu_directory 
  98.       Caption         =   "&Directory"
  99.       Begin Menu Menu_directory_item 
  100.          Caption         =   "&Change"
  101.          Index           =   0
  102.       End
  103.       Begin Menu Menu_directory_item 
  104.          Caption         =   "&Parent"
  105.          Index           =   1
  106.       End
  107.       Begin Menu Menu_directory_item 
  108.          Caption         =   "&Dir list"
  109.          Index           =   2
  110.       End
  111.    End
  112.    Begin Menu Menu_settings 
  113.       Caption         =   "&Settings"
  114.       Begin Menu Menu_setting_items 
  115.          Caption         =   "&Ascii type"
  116.          Index           =   0
  117.       End
  118.       Begin Menu Menu_setting_items 
  119.          Caption         =   "&Binary type"
  120.          Index           =   1
  121.       End
  122.       Begin Menu Menu_setting_items 
  123.          Caption         =   "&Mask"
  124.          Index           =   2
  125.       End
  126.    End
  127.    Begin Menu Quote_menu 
  128.       Caption         =   "&Quote"
  129.       Begin Menu Quote_command 
  130.          Caption         =   "&Command"
  131.       End
  132.    End
  133.    Begin Menu AboutMenu 
  134.       Caption         =   "A&bout"
  135.    End
  136. Const MB_YESNO = 4, MB_ICONSTOP = 16, MB_DEFBUTTON2 = 256
  137. Const ID_YES = 6, ID_NO = 7
  138. Sub AboutMenu_Click ()
  139.   Dim Msg, Endofl
  140.   Endofl = Chr$(13) & Chr$(10)
  141.   Msg = "   FTP File transfer utility" & Endofl
  142.   Msg = Msg & "   developed in Visual Basic" & Endofl
  143.   Msg = Msg & "      by Kees de Rooij and " & Endofl
  144.   Msg = Msg & "Richard Terpstra (terpstr2@ksla.nl)" & Endofl
  145.   Msg = Msg & " " & Endofl
  146.   Msg = Msg & "using FTP4W.DLL from Ph. Jounin (SNCF)" & Endofl
  147.   MsgBox Msg, 64, "About"
  148. End Sub
  149. Sub Disable_menus ()
  150.   Menu_connection.Enabled = False
  151.   Menu_file.Enabled = False
  152.   Menu_directory.Enabled = False
  153.   Menu_settings.Enabled = False
  154.   Quote_menu.Enabled = False
  155. End Sub
  156. Sub Do_display_options ()
  157.   Disable_menus
  158.   Ftp_form!Message.Caption = ""
  159.   Ftp_form.MousePointer = 11
  160. End Sub
  161. Sub Enable_menus ()
  162.   Menu_connection.Enabled = True
  163.   Menu_file.Enabled = True
  164.   Menu_directory.Enabled = True
  165.   Menu_settings.Enabled = True
  166.   Quote_menu.Enabled = True
  167. End Sub
  168. Function Exit_program () As Integer
  169.   'give a message box to enable the operator to terminate
  170.   'the program or not
  171.   Dim DgDef, Msg, Response, Title
  172.   Title = "Close application"
  173.   Msg = "The application is still connected " & Chr$(13) & Chr$(10)
  174.   Msg = Msg & "Do you want to finish anyway ?"
  175.   DgDef = MB_YESNO + MB_ICONSTOP + MB_DEFBUTTON2
  176.   Response = MsgBox(Msg, DgDef, Title)
  177.   Exit_program = Response
  178. End Function
  179. Sub Form_Load ()
  180.   Connected = False
  181.   DirType = False
  182.   TransType = Asc(TYPE_A)
  183.   MaskType = ""
  184.   Success = FtpInit(Hwnd)
  185.   If Success = FTPERR_OK Then
  186.     FtpSetSynchronousMode
  187.     Success = FtpSetType(TransType)
  188.   Else
  189.     Ms$ = FTP4W_Error(Success)
  190.     Ftp_form!Message.Caption = Ms$
  191.   End If
  192. End Sub
  193. Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  194.   'when finishing via - control program checks for connected
  195.   'and gives a message to the operator, he then can decide
  196.   'to finish or not
  197.   'Also a warning will be given when the release was not
  198.   'successfull
  199.   If Connected Then
  200.     If Exit_program() = ID_YES Then
  201.       Success = FtpLocalClose()  'do both Close
  202.       Success = FtpRelease()     'and Release
  203.       If Success <> FTPERR_OK Then
  204.         MsgBox "The application has not been Released succesfully", 64, "Information"
  205.         Cancel = False
  206.       End If
  207.       Cancel = False
  208.     Else
  209.       Cancel = True
  210.     End If
  211.   Else
  212.     Ftp_form!Message.Caption = ""
  213.     Success = FtpLocalClose()  'do both Close
  214.     Success = FtpRelease()     'and Release
  215.     If Success <> FTPERR_OK Then
  216.       MsgBox "The application has not been Released succesfully", 64, "Information"
  217.     End If
  218.     Cancel = False
  219.   End If
  220. End Sub
  221. Sub Menu_connection_Click ()
  222.   'set menu active depending on connection
  223.   'connect
  224.   Menu_connection_item(0).Enabled = (Connected = False)
  225.   'disconnect
  226.   Menu_connection_item(1).Enabled = (Connected = True)
  227.   'abort
  228.   Menu_connection_item(2).Enabled = (Connected = True)
  229. End Sub
  230. Sub Menu_connection_item_Click (Index As Integer)
  231.   'do action depending on item
  232.   Select Case Index
  233.   Case 0                    'Connect
  234.     ConnectForm.Show 1
  235.     If OKDialog = False Then
  236.       Exit Sub
  237.     End If
  238.     Do_display_options
  239.     Success = FtpLogin(HostName, Userid, Password, Hwnd, w%)
  240.     Undo_display_options
  241.     If Success = FTPERR_OK Then
  242.       Connected = True
  243.       Ftp_form.Host_name.Caption = HostName
  244.     Else
  245.       Ms$ = FTP4W_Error(Success)
  246.       Ftp_form!Message.Caption = Ms$
  247.     End If
  248.   Case 1                    'Disconnect
  249.     Do_display_options
  250.     Success = FtpCloseConnection()
  251.     Undo_display_options
  252.     If Success = FTPERR_OK Then
  253.       Connected = False
  254.       Ftp_form.Host_name.Caption = "< Not connected >"
  255.     Else
  256.       Ms$ = FTP4W_Error(Success)
  257.       Ftp_form!Message.Caption = Ms$
  258.     End If
  259.   Case 2                    'Abort
  260.     Do_display_options
  261.     Success = FtpAbort()
  262.     Undo_display_options
  263.     If Success <> FTPERR_OK Then
  264.       Ms$ = FTP4W_Error(Success)
  265.       Ftp_form!Message.Caption = Ms$
  266.     Else
  267.       Ftp_form!Message.Caption = "Abort OK"
  268.     End If
  269.   Case 3                    'Exit
  270.     If Connected Then       'when connected show tha dialog
  271.       If Exit_program() = ID_YES Then
  272.         Success = FtpLocalClose()  'do both Close
  273.         Success = FtpRelease()     'and Release
  274.         If Success <> FTPERR_OK Then
  275.           MsgBox "The Application has not been released succesfully", 64, "Info"
  276.         End If
  277.         End                      'exit program
  278.       End If
  279.     Else   'not connected
  280.       Success = FtpLocalClose()  'do both Close
  281.       Success = FtpRelease()     'and Release
  282.       If Success <> FTPERR_OK Then
  283.         MsgBox "The Application has not been released succesfully", 64, "Info"
  284.       End If
  285.       End                        'exit program
  286.     End If
  287.   End Select
  288. End Sub
  289. Sub Menu_directory_Click ()
  290.   'set menu active depending on connection
  291.   'change
  292.   Menu_directory_item(0).Enabled = (Connected = True)
  293.   'parent
  294.   Menu_directory_item(1).Enabled = (Connected = True)
  295.   'dir list
  296.   Menu_directory_item(2).Enabled = (Connected = True)
  297. End Sub
  298. Sub Menu_directory_item_Click (Index As Integer)
  299.   Dim C_dir$
  300.   Select Case Index
  301.   Case 0          'change
  302.     C_dir$ = InputBox$("Enter directory name : ", "Change directory")
  303.     Do_display_options
  304.     Success = FtpCWD(C_dir$)
  305.     Undo_display_options
  306.     If Success <> FTPERR_OK Then
  307.       Ms$ = FTP4W_Error(Success)
  308.       Ftp_form!Message.Caption = Ms$
  309.     Else
  310.       Ftp_form!Message.Caption = "Change dir OK"
  311.     End If
  312.   Case 1          'parent
  313.     C_dir$ = ".."
  314.     Do_display_options
  315.     Success = FtpCWD(C_dir$)
  316.     Undo_display_options
  317.     If Success <> FTPERR_OK Then
  318.       Ms$ = FTP4W_Error(Success)
  319.       Ftp_form!Message.Caption = Ms$
  320.     Else
  321.       Ftp_form!Message.Caption = "Change dir OK"
  322.     End If
  323.   Case 2
  324.     DirType = False
  325.     Do_display_options
  326.     Do_the_dirlist
  327.     Ftp_form.MousePointer = 0
  328.     Enable_menus
  329.   End Select
  330. End Sub
  331. Sub Menu_file_Click ()
  332.   'set menu active depending on connection
  333.   'put
  334.   Menu_file_item(0).Enabled = (Connected = True)
  335.   'get
  336.   Menu_file_item(1).Enabled = (Connected = True)
  337. End Sub
  338. Sub Menu_file_item_Click (Index As Integer)
  339.   Select Case Index
  340.   Case 0      'get
  341.     Get_file.Show 1
  342.     If OKDialog = False Then Exit Sub
  343.     '
  344.     Do_display_options
  345.     Success = FtpRecvFile(Src_nam, Dest_nam, TransType, BNotify%, Hwnd, Msg%)
  346.     Undo_display_options
  347.     If Success <> FTPERR_OK Then
  348.       Ms$ = FTP4W_Error(Success)
  349.       Ftp_form!Message.Caption = Ms$
  350.     Else
  351.       Ftp_form!Message.Caption = "Receive file OK"
  352.     End If
  353.   Case 1      'put
  354.     Put_file.Show 1
  355.     If OKDialog = False Then Exit Sub
  356.     Do_display_options
  357.     Success = FtpSendFile(Src_nam, Dest_nam, TransType, BNotify%, Hwnd, Msg%)
  358.     Undo_display_options
  359.     If Success <> FTPERR_OK Then
  360.       Ms$ = FTP4W_Error(Success)
  361.       Ftp_form!Message.Caption = Ms$
  362.     Else
  363.       Ftp_form!Message.Caption = "Send file OK"
  364.     End If
  365.   End Select
  366. End Sub
  367. Sub Menu_setting_items_Click (Index As Integer)
  368.   Select Case Index
  369.   Case 0                     'Ascii
  370.     TransType = Asc(TYPE_A)
  371.   Case 1                     'binary
  372.     TransType = Asc(TYPE_I)
  373.   Case 2                     'mask
  374.     MaskType = Get_mask_type()
  375.     Do_display_options
  376.     Do_the_dirlist
  377.     Ftp_form.MousePointer = 0
  378.     Enable_menus
  379.   End Select
  380. End Sub
  381. Sub Menu_settings_Click ()
  382.   Menu_setting_items(0).Checked = (TransType = Asc(TYPE_A))
  383.   Menu_setting_items(1).Checked = (TransType = Asc(TYPE_I))
  384.   Menu_setting_items(0).Enabled = (Connected = True)
  385.   Menu_setting_items(1).Enabled = (Connected = True)
  386.   Menu_setting_items(2).Enabled = (Connected = True)
  387. End Sub
  388. Sub Quote_command_Click ()
  389.   'execute a command not implemented as standard command
  390.   'in FTP4W.BAS
  391.   Dim Answ$, DefVal, Msg, Title
  392.   Dim Result As String
  393.   Result = String$(255, 32)     'init the string ! essential
  394.   DefVal = ""
  395.   Msg = "Enter FTP command : "
  396.   Title = "Quote option for FTP"
  397.   Answ$ = InputBox$(Msg, Title, DefVal)
  398.   If Len(Trim$(Answ$)) = 0 Then
  399.     Exit Sub
  400.   Else
  401.     Do_display_options
  402.     Success = FtpQuote(Answ$, Result, Len(Result))
  403.     Undo_display_options
  404.     If Success = FTPERR_OK Then
  405.       Result = Trim$(Result)
  406.       Result = Left$(Result, Len(Result) - 1)
  407.       Ftp_form!Message.Caption = "FTP Quote OK" 'Result
  408.     Else
  409.       M$ = FTP4W_Error(Success)
  410.       Ftp_form!Message.Caption = M$
  411.     End If
  412.   End If
  413. End Sub
  414. Sub Quote_menu_Click ()
  415.   Quote_command.Enabled = (Connected = True)
  416. End Sub
  417. Sub Undo_display_options ()
  418.   Ftp_form.MousePointer = 0
  419.   Enable_menus
  420. End Sub
  421.